(in-package #:org.shirakumo.fraf.trial.examples)

(define-example system-info
  :title "System Information"
  :description "Displays a variety of system information that Trial can expose to the user."
  :superclasses (alloy:observable-object)
  :slots ((cpu :initform (make-array 600 :initial-element 0.0 :element-type 'single-float))
          (ram :initform (make-array 600 :initial-element 0.0 :element-type 'single-float))
          (gpu :initform (make-array 600 :initial-element 0.0 :element-type 'single-float))
          (vram :initform (make-array 600 :initial-element 0.0 :element-type 'single-float))
          (io :initform (make-array 600 :initial-element 0.0 :element-type 'single-float))
          (gc :initform (make-array 600 :initial-element 0.0 :element-type 'single-float))
          (last-cpu :initform 0) (last-gpu :initform 0)
          (last-io :initform 0) (last-gc :initform 0))
  (enter (make-instance 'render-pass) scene))

(defmethod setup-ui ((scene system-info-scene) panel)
  (let ((layout (make-instance 'org.shirakumo.alloy.layouts.constraint:layout))
        (focus (make-instance 'alloy:vertical-focus-list))
        (info (make-instance 'alloy:grid-layout :col-sizes '(150 T) :row-sizes '(30)))
        (cpu (alloy:represent (slot-value scene 'cpu) 'alloy:plot :y-range `(0 . 1)))
        (ram (alloy:represent (slot-value scene 'ram) 'alloy:plot :y-range `(0 . ,(nth-value 1 (org.shirakumo.machine-state:gc-room)))))
        (gpu (alloy:represent (slot-value scene 'gpu) 'alloy:plot :y-range `(0 . 1)))
        (vram (alloy:represent (slot-value scene 'vram) 'alloy:plot :y-range `(0 . ,(nth-value 1 (org.shirakumo.machine-state:gpu-room)))))
        (gc (alloy:represent (slot-value scene 'gc) 'alloy:plot :y-range `(0 . .1)))
        (io (alloy:represent (slot-value scene 'io) 'alloy:plot :y-range `(0 . .1))))
    (alloy:enter cpu layout :constraints `((:width 300) (:height (* 0.31 :rh)) (:left 10) (:top 10)))
    (alloy:enter ram layout :constraints `((:width 300) (:chain :right ,cpu 10)))
    (alloy:enter gpu layout :constraints `((:width 300) (:height (* 0.31 :rh)) (:left 10) (:center :height)))
    (alloy:enter vram layout :constraints `((:width 300) (:chain :right ,gpu 10)))
    (alloy:enter gc layout :constraints `((:width 300) (:height (* 0.31 :rh)) (:left 10) (:bottom 10)))
    (alloy:enter io layout :constraints `((:width 300) (:chain :right ,gc 10)))
    (alloy:enter "CPU" layout :constraints `((:size 100 20) (:inside ,cpu :halign :left :valign :top :margin 5)))
    (alloy:enter "RAM" layout :constraints `((:size 100 20) (:inside ,ram :halign :left :valign :top :margin 5)))
    (alloy:enter "GPU" layout :constraints `((:size 100 20) (:inside ,gpu :halign :left :valign :top :margin 5)))
    (alloy:enter "VRAM" layout :constraints `((:size 100 20) (:inside ,vram :halign :left :valign :top :margin 5)))
    (alloy:enter "GC Pause" layout :constraints `((:size 100 20) (:inside ,gc :halign :left :valign :top :margin 5)))
    (alloy:enter "IO" layout :constraints `((:size 100 20) (:inside ,io :halign :left :valign :top :margin 5)))
    (macrolet ((show (label &rest values)
                 `(progn (alloy:enter ,label info)
                         (alloy:enter (format NIL "~@{~a~^ ~}" ,@values) info)))
               (button (label &body body)
                 `(progn (alloy:enter "" info)
                         (make-instance 'alloy:button* :value ,label :on-activate (lambda () ,@body)
                                                       :layout-parent info :focus-parent focus))))
      (show "Lisp" (lisp-implementation-type) (lisp-implementation-version))
      (show "OS" (software-type) (software-version))
      (show "Machine" (machine-type) (machine-version))
      (show "OpenGL" (gl-vendor) (gl-property :major-version) (gl-property :minor-version) (profile *context*))
      (show "App Version" (version :app))
      (show "Bin Version" (version :binary))
      (show "Username" (username T))
      (show "Language" (system-locale:language) (system-locale:locale))
      (show "Self" (self))
      (show "Logfile" (logfile))
      (show "Data Root" (data-root))
      (show "Temp Dir" (tempdir))
      (show "Config Dir" (config-directory))
      (button "Open File Manager" (open-in-file-manager #p "~/"))
      (button "Open Browser" (open-in-browser "https://shirakumo.org"))
      (button "Show Error" (emessage "This is an example error message. Nothing actually went wrong, don't worry.")))
    (alloy:enter info layout :constraints `((:height :rh) (:left 620) (:right 10)))
    (alloy:finish-structure panel layout focus)))

(defmethod handle ((ev tick) (panel system-info-scene))
  (with-slots (cpu ram gpu vram gc io last-cpu last-gpu last-io last-gc) panel
    (flet ((push-value (func value array)
             (declare (type (simple-array single-float (*)) array))
             (loop for i from 1 below (length array)
                   do (setf (aref array (1- i)) (aref array i)))
             (setf (aref array (1- (length array))) (float value 1f0))
             (alloy:notify-observers func panel array panel)))
      (let ((total (org.shirakumo.machine-state:process-time)))
        (when (< 0 total)
          (push-value 'cpu (- total last-cpu) cpu))
        (setf last-cpu total))
      (multiple-value-bind (free total) (org.shirakumo.machine-state:gc-room)
        (push-value 'ram (- total free) ram))
      (let ((total (org.shirakumo.machine-state:gpu-time)))
        (when (< 0 total)
          (push-value 'gpu (- total last-gpu) gpu))
        (setf last-gpu total))
      (multiple-value-bind (free total) (org.shirakumo.machine-state:gpu-room)
        (push-value 'vram (- total free) vram))
      (let ((total (org.shirakumo.machine-state:gc-time)))
        (when (< 0 last-gc)
          (push-value 'gc (- total last-gc) gc))
        (setf last-gc total))
      (let ((total (org.shirakumo.machine-state:process-io-bytes)))
        (when (< 0 last-io)
          (push-value 'io (- total last-io) io))
        (setf last-io total)))))
